home *** CD-ROM | disk | FTP | other *** search
/ Risc World 3 / Risc World 3.iso / SOFTWARE / ISSUE3 / PD / NEWALARM / !NewAlarm / Source / SHeap (.txt) < prev   
RISC OS BBC BASIC V Source  |  2000-10-05  |  6KB  |  195 lines
  1.  Sliding_Heap Library
  2.  requires SlidingHeap 2.00
  3.  module and PROCs
  4.  Steven Haslam 1992
  5. initheaps(heapsize%,slidingblocks%)
  6.  Call this procedure to create the empty heap before you do anything else
  7. fixedheapsize%=heapsize%
  8. Lheap_trigger%=
  9. _heap_pageup(
  10. +fixedheapsize%+20+20*slidingblocks%-&8000)
  11. setslotsize(heap_trigger%)
  12. _heap_slotsize<heap_trigger% 
  13.  130,"Unable to initialise heap"
  14. fixedheapbase%=
  15. %slidingheapbase%=
  16. +fixedheapsize%
  17.  "OS_Heap",0,fixedheapbase%,,fixedheapsize%
  18.  "SlidingHeap_Create",slidingheapbase%,2,slidingblocks%
  19.  "SlidingHeap_VerifyHeap",slidingheapbase%
  20. create_anchor(name$)
  21.  Every sliding block must have an anchor.   The block gets moved around
  22.  in memory, but its current address can always be found at !anchor%
  23.  This function creates an anchor and returns its address,
  24.  which should be assigned to a variable anchor% for future reference.
  25.  The name you supply will be used in error messages and heap info reports
  26.  space%
  27.  space% 4+
  28.  name$+1
  29. !space%=0
  30. $(space%+4)=name$
  31. =space%
  32. create_named_sliding_block(anchor%,size%)
  33.  This is the function which actually creates a heap block.
  34.  First you must have created an anchor for the block.
  35.  trysize%
  36. size%=
  37. _heap_wordup(size%)
  38. #7trysize%=
  39. _heap_pageup(
  40. _heap_nextfree+size%-&7FF4)
  41.  trysize%>heap_trigger% 
  42. setslotsize(trysize%)
  43. _heap_slotsize<trysize% 
  44. '#    
  45. setslotsize(heap_trigger%)
  46. (D    
  47.  131,"Not enough room to create block """+$(anchor%+4)+""""
  48. )        
  49.     heap_trigger%=trysize%
  50.  "SlidingHeap_NewBlock",slidingheapbase%,anchor%,size%,anchor%+4
  51.  "SlidingHeap_VerifyHeap",slidingheapbase%
  52. extend_named_sliding_block(anchor%,newsize%)
  53.  This function increases (or decreases - the name is misleading) the size
  54.  of a heap block.  Other blocks may slide around as the block size changes.
  55.  If the block did not previously exist, it will be created - so there's not
  56.  really a lot of point using PROCcreate_named_sliding_block, I suppose...
  57.  Note that newsize% is the TOTAL size of the resulting block, not the
  58.  increase/decrease in size - i.e. you need to keep track of the current size.
  59.  !anchor%=0 
  60. create_named_sliding_block(anchor%,newsize%):
  61.  !anchor%>
  62. _heap_nextfree 
  63.  129,"Block beyond heap limits"
  64. :$newsize%=
  65. _heap_wordup(newsize%)
  66.  "SlidingHeap_DescribeBlock",slidingheapbase%,anchor% 
  67.  ,,oldsize%
  68. larger%=newsize%>oldsize%
  69.  larger% 
  70. >G  trysize%=
  71. _heap_pageup(
  72. _heap_nextfree+(newsize%-oldsize%)-&7FFC)
  73.  trysize%>heap_trigger% 
  74. setslotsize(trysize%)
  75. A$    
  76. _heap_slotsize<trysize% 
  77. B%      
  78. setslotsize(heap_trigger%)
  79. C=      
  80.  132,"Not enough room to extend block #"+
  81. ~anchor%
  82.       
  83. E       heap_trigger%=trysize%
  84. F        
  85.  "SlidingHeap_ExtendBlock",slidingheapbase%,anchor%,newsize%
  86. J1trysize%=
  87. _heap_pageup(
  88. _heap_nextfree-&7FFC)
  89.  trysize%<>heap_trigger% 
  90. setslotsize(trysize%)
  91.    heap_trigger%=trysize%
  92.  "SlidingHeap_VerifyHeap",slidingheapbase%
  93. scrap_sliding_block(anchor%)
  94.  This function discards a sliding block, returning its memory to the heap.
  95.  Note that the anchor is NOT deleted and can be reused later.
  96.  In fact anchors cannot be deleted.
  97.  !anchor%=0 
  98.  "SlidingHeap_ScrapBlock",slidingheapbase%,anchor%
  99. X1trysize%=
  100. _heap_pageup(
  101. _heap_nextfree-&7FFC)
  102.  trysize%<>heap_trigger% 
  103. setslotsize(trysize%)
  104.   heap_trigger%=trysize%
  105. !anchor%=0
  106.  "SlidingHeap_VerifyHeap",slidingheapbase%
  107. destroyheaps
  108.  This procedure destroys the entire sliding heap.
  109. setslotsize(
  110. -&8000)
  111.  Various procedures called by Sliding Heap Library procedures
  112. _heap_slotsize
  113.  "Wimp_SlotSize",-1,-1 
  114. _heap_pageup(n%)
  115.  "OS_ReadMemMapInfo" 
  116. =(n%+R0%-1) 
  117.  (R0%-1)
  118. setslotsize(newsize%)
  119.  "Wimp_SlotSize",newsize%,-1
  120. _heap_nextfree
  121.  nextfree%
  122.  "SlidingHeap_NextFree",slidingheapbase% 
  123.  nextfree%
  124. =nextfree%
  125. _heap_wordup(x%)=(x%+3) 
  126. heap_store(anchor%,
  127.  size%,inc%,
  128.  ptr%,L%,string$)
  129.  string$<>"" 
  130. (string$)
  131.  ptr%-!anchor%+L%+1>size% 
  132.    size%+=inc%
  133. extend_named_sliding_block(anchor%,size%)
  134.  string$<>"" 
  135.  $ptr%=string$:ptr%+=L%:?ptr%=10
  136. _heap_numtostr(d%,n%)=
  137. d%,"0")+
  138. ~n%,d%)
  139. _heap_snumtostr(d%,n%)=
  140. d%," ")+
  141.  n%,d%)
  142. heapsinfo
  143.  "OS_Heap",1,fixedheapbase% 
  144.  ,,bigbloc%,totfree%
  145.  "Fixed heap
  146.  CTRL-O : pause scrolling until SHIFT
  147.  "----- ----"
  148.  "Heap base    : &";
  149. _heap_numtostr(8,fixedheapbase%)
  150.  "Heap size    : ";
  151. _heap_bytes2(fixedheapsize%)
  152.  "Largest free : ";
  153. _heap_bytes2(bigbloc%)
  154.  "Total free   : ";
  155. _heap_bytes2(totfree%)
  156.  "Sliding heap"
  157.  "------- ----"
  158.  "SlidingHeap_HeapInfo",slidingheapbase%
  159. _heap_bytes(b%)
  160.  end%
  161.  "OS_ConvertFixedFileSize",b%,block%,block%+&100 
  162.  ,end%
  163.  ?end%=13
  164.  =$block%
  165. _heap_bytes2(b%)
  166.  end%
  167.  "OS_ConvertFileSize",b%,block%,block%+&100 
  168.  ,end%
  169.  ?end%=13
  170.  =$block%
  171. create_fixed_block(size%)
  172.  pointer%,flag%
  173.  "XOS_Heap",2,fixedheapbase%,,size% 
  174.  ,,pointer%;flag%
  175.  flag% 
  176. extendfixedheap
  177.  "XOS_Heap",2,fixedheapbase%,,size% 
  178.  ,,pointer%;flag%
  179.  =pointer%
  180. extendfixedheap
  181.  nshb%,extend%,trysize%
  182.  "OS_ReadMemMapInfo" 
  183.  extend%
  184. % trysize%=
  185. _heap_slotsize+extend%
  186. setslotsize(trysize%)
  187. _heap_slotsize<trysize% 
  188.  255,"No room to extend fixed heap"
  189. # nshb%=slidingheapbase%+extend%
  190.  "SlidingHeap_ShiftHeap",slidingheapbase%,nshb%
  191.  "OS_Heap",5,fixedheapbase%,,extend%
  192.  fixedheapsize%+=extend%
  193.  slidingheapbase%=nshb%
  194.  "SlidingHeap_VerifyHeap",slidingheapbase%
  195.